unit MakeTextBitmap;

interface

uses
  Classes, sysUtils, Types, Graphics, hyieutils, imageEnproc;

procedure MakeText(var Bitmap: TBitMap; aFontName: String;
  aFontSize: integer; style:TFontStyles; aText: TStringList);

procedure GetLTWhiteSpace(var x, y:integer; src:TIEBitmap);
procedure RemoveLTWhiteSpace(x,y:integer; src:TIEBitmap);

implementation
uses
  siAuto;

type
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32; 
  PRGB32Array = ^TRGB32Array;

procedure RemoveLTWhiteSpace(x,y:integer; src:TIEBitmap);
var
  BitMap:TBitmap;
  sRect, dRect:TRect;
begin
  BitMap := TBitMap.Create;
  try
    sRect := Rect(x, y, src.Width, src.Height);
    dRect := Rect(0,0, src.Width - x, src.Height - y);

    BitMap.Canvas.Lock;
    try
      BitMap.Width:= dRect.Right;
      BitMap.Height:= dRect.Bottom;
      Bitmap.Canvas.CopyMode := cmSrcCopy;
      Bitmap.Canvas.CopyRect(dRect, src.Canvas, sRect );

      src.Assign( BitMap );
    finally
      BitMap.Canvas.Unlock;
    end;
  finally
    BitMap.Free;
  end;
end;

procedure GetLTWhiteSpace(var x, y:integer; src:TIEBitmap);
var
  ix,iy:integer;
  Line: PRGB32Array;
  bitMap:TBitmap;
  includeBlack: Boolean;
begin
  x := high(integer);
  y := high(integer);
  bitMap := TBitMap.Create;
  try
    bitMap.Width := src.Width;
    bitMap.Height:= src.Height;
    src.CopyToTBitmap(bitMap);
    bitMap.PixelFormat := pf32bit;

    for iy := 0 to BitMap.Height - 1 do
    begin
      line := bitMap.ScanLine[iy];
      includeBlack := False;
      for ix := 0 to BitMap.Width - 1 do
      begin
        if (Line[ix].R <> 255) and (line[ix].G <> 255) and (line[ix].B <> 255) then
        begin
          if ix < x then
          begin
            x := ix;
            includeBlack := True;
          end;
        end;
      end;
      if (includeBlack) and ( iy < y) then y := iy;
    end;

    if x = high(integer) then x := 0;
    if y = high(integer) then y := 0;

  finally
    bitmap.free;
  end;
end;


procedure MakeText(var Bitmap: TBitMap; aFontName: String;
  aFontSize: integer; style:TFontStyles; aText: TStringList);
var
  aLineGap ,aWidth, aHeight:integer;
  imgHeight, imgWidth:integer;
  Buff, sampleText:String;
  x,y, iMax, I: Integer;
  tmpList:TStringLIst;
const
  margine = 0;
begin
  if Assigned(BitMap) then Bitmap.free;

  tmpList := TStringLIst.Create;
  try
    tmplist.Assign( aText );
    for i := tmpList.Count - 1 downto 0 do
    begin
      if Trim(tmpList.Strings[i])  = '' then
        tmpList.Delete(i)
      else
        break;
    end;

    if tmpList.Count = 0 then
      tmpList.Add(' ');

    iMax := 0;
    sampleText := '';
    for I := 0 to tmpList.Count - 1 do
    begin
      Buff:= tmpList.Strings[i];
      if length(Buff) > iMax then
      begin
        iMax := length(Buff);
        sampleText := Buff;
      end;
    end;

    BitMap := TBitmap.Create;
    Bitmap.PixelFormat := pf1bit;
    bitMap.Canvas.Font.Name := aFontName;
    bitMap.Canvas.Font.Size := aFontSize;
    bitMap.Canvas.Font.Style := Style;

    aHeight := bitMap.Canvas.TextHeight(sampleText);
    aWidth  := bitMap.Canvas.TextWidth(sampleText);
    aLineGap := (aHeight div 3) * 2;

    if tmpList.Count = 1 then
      imgHeight := aHeight
    else
      imgHeight := ((aHeight + aLineGap) * tmpList.Count) - alineGap;

    imgWidth  := aWidth + (margine * 2);

    imgHeight := imgHeight + (margine * 2);

    bitMap.Width  := imgWidth;
    bitMap.Height := imgHeight;

    x:= margine;
    y:= margine;
    Bitmap.Canvas.Lock;
    BitMap.Canvas.Brush.Color := clWhite;
    BitMap.Canvas.Brush.Style := bsClear;
    BitMap.Canvas.FillRect( Rect(0,0, BitMap.Width, BitMap.Height) );
    try
      for I := 0 to tmpList.Count - 1 do
      begin
        Buff := tmpList.Strings[i];
        Bitmap.Canvas.TextOut(x, y, Buff);

        y := y + aHeight + aLineGap;
      end;
    finally
      bitmap.Canvas.Unlock;
    end;
  finally
    tmpLIst.Free;
  end;
end;

end.
